subtittle_text_mining

biblioteki

# calculations
library(tm) 
library(dplyr)
library(SnowballC)

#visualization
library(wordcloud2)

wstęp

Celem projektu jest znalezienie najbardziej pozytywnych filmów ze zbioru. Źródło dialogów pochodzi z serwisu https://nlds.soe.ucsc.edu/fc2. Pliki podzielone są na kategorie:

path = file.path(getwd(), "dialogs/")
category_list = dir(path)
category_list

##  [1] "Action"    "Adventure" "Animation" "Biography" "Comedy"   
##  [6] "Crime"     "Drama"     "Family"    "Fantasy"   "Film-Noir"
## [11] "History"   "Horror"    "Music"     "Musical"   "Mystery"  
## [16] "Romance"   "Sci-Fi"    "Short"     "Sport"     "Thriller" 
## [21] "War"       "Western"

W celu przyśpieszenia procesu ograniczono się tylko do części kategorii.

path = file.path(getwd(), "dialogs_selected/")
category_list = dir(path)
category_list

##  [1] "Action"    "Adventure" "Biography" "Comedy"    "Crime"    
##  [6] "Drama"     "Family"    "Fantasy"   "Horror"    "Sci-Fi"   
## [11] "Short"

wszystkie filmy w podkategoriach zostały zaimportowane do “korpusu”

corpus <- Corpus(DirSource(path, recursive=T))

W uzyskanym źródle imiona bohaterów oraz opisy sA pisane samymi dużymi literami. Dlatego napisana została niestandardowa funkcja dla preprocessingu, usuwająca takie wystąpienia Usunięte będzie w ten sposób również kilku okrzyków ale ich wpływ uznany jest za nieznaczny.

remAllCap <- function (x){gsub("\\b[A-Z]+\\b", "", x)}
corpus <- tm_map(corpus, remAllCap)

Zastosowano serię narzędzi do odpowiedniej obróbki wstępnej dialogów oraz zamaskowano bardzo popularnego angielskiego przekleństwa:

corpus <- tm_map(corpus, tolower)
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, removeNumbers)
corpus <- tm_map(corpus, removeWords, c(stopwords("english")))
remSwer <- function(x){gsub("fuck", "f**k", x)}
corpus <- tm_map(corpus, remSwer)
corpus_org <-corpus
corpus_org <- tm_map(corpus, stripWhitespace)
corpus <- tm_map(corpus, stemDocument)
corpus <- tm_map(corpus, stripWhitespace)

Utoworzenie Macierzy wyrażenie-dokument

tdm <- TermDocumentMatrix(corpus)

analiza pozytywnego lub negatywnego znaczenia dialogów na podstawie występowania słów pozytywnych lub negatywnych.

Użyta została lekko zmodyfikowana funkcja przerabiana na zajęciach. Przerobiony został wynik funkcji jako różnica udziału procentowego pozytywnych i negatywnych słów do wszystkich negatywnych i pozytywnych słów. Za słowniki negatywnych i pozytywnych słów zostały urzyta baza prezentowana w instrukcji do zajęć.

hu.liu.pos = scan(file.path(getwd(), "opinion-lexicon-English","positive-words.txt"),
                  what='character', comment.char=';')
hu.liu.neg = scan(file.path(getwd(), "opinion-lexicon-English","negative-words.txt"),
                  what='character', comment.char=';')

score.sentiment = function(sentences, pos.words, neg.words, .progress='none')
{
  require(plyr)
  require(stringr)
  scores = laply(sentences, function(sentence, pos.words, neg.words) {
    word.list = str_split(sentence, '\\s+')
    words = unlist(word.list)
    pos.matches = match(words, pos.words)
    neg.matches = match(words, neg.words)
    pos.matches = !is.na(pos.matches)
    neg.matches = !is.na(neg.matches)
    score = c(sum(pos.matches)/length(words), sum(neg.matches)/length(words))
    return(score)
  }, pos.words, neg.words, .progress=.progress )
}

Funkcja została użyta do wcześniej zaczytanego ciała:

max = length(list.files(path=path, recursive = T))

i <- 1
names = c()
pos = c()
neg=c()

while(i<=max){
  sample.text = corpus[[i]]$content
  result = score.sentiment(sample.text, hu.liu.pos , hu.liu.neg)
  names = c(names, gsub("_dialog.txt","",corpus[[i]]$meta$id))
  pos = c(pos, result[1])
  neg = c(neg, result[2])
  i=i+1
}

Wyniki ograniczono tylko do tych filmów w których pozytywne i negatywne wyrażenia stanowiły co najmniej 5% wszystkich wyrażeń.

df = data.frame(names, pos, neg )
df <- df %>% filter(pos >0.5 & neg >0.5) %>% distinct() %>% mutate(per_pos = pos/(pos+neg))
df.pos <- df %>%  arrange(desc(per_pos)) 
df.neg <- df %>%  arrange(per_pos) 

W ten sposób udało sie wyodrębnić najbardziej pozytywne filmy w zbiorze:

top_n(df.pos, 15)

## Selecting by per_pos

## [1] names   pos     neg     per_pos
## <0 rows> (or 0-length row.names)

Oraz najbardziej negarywne filmy w zbiorze:

top_n(df.neg, -15)

## Selecting by per_pos

## [1] names   pos     neg     per_pos
## <0 rows> (or 0-length row.names)

Ostatnim etapem jest wizualizacja częstości występowania słów poprzez chmurę wyrazów. Całość przygotowania zostałą zamknięta w postaci funkcji:

for.cloud = function(name, names, corpus_org){
  id = match(name, names)
  print(corpus_org[[id]]$meta$id)
  print(id)
  ##POS taging
  library(NLP)
  library(openNLP)
  library(tm)
  sent_token_annotator <-  Maxent_Sent_Token_Annotator()
  word_token_annotator <-  Maxent_Word_Token_Annotator()
  sample.text = corpus_org[[id]]$content
  a1 = annotate(sample.text,list(sent_token_annotator,word_token_annotator))
  pos_tag_annotator <-  Maxent_POS_Tag_Annotator()
  a3 = annotate(sample.text, pos_tag_annotator, a1)
  a3w = subset(a3, type=='word')
  max = length(a3w)
  k = 1
  words = c()
  while(k<=max){
    p = unlist(a3w[k]$features)
    if(p=="NN" || p=="VB"){
      word <- substr(sample.text,a3w[k]$start, a3w[k]$end)
    }
    words = c(words, word)
    k = k + 1
  }
  words= words[words!='m' & words!='ll' & words!="ve" & words!="dont"]
  tb <- as.data.frame(table(words))
  colnames(tb) <- c('word','freq')
  tb <- tb %>% arrange(desc(freq))
  return(tb)
}

Poniżej przykład jednego z pozytywnych filmów: Amadeus

words.pos <- for.cloud('amadeus', names, corpus_org)

## [1] "amadeus_dialog.txt"
## [1] 924

#path.png = file.path(getwd(), "sample pictures/play.png")
#wordcloud2(data = words.neg, figPath = path.png, size = 1.5)

oraz negatywny “Pine Apple Express”

#words.neg <- for.cloud('pineappleexpress', names, corpus_org)
path.png = file.path(getwd(), "sample pictures/movie.png")
#wordcloud2(data = words.pos, figPath = path.png, size = 1)

Caption for the picture.

Oraz bonusowy pozytywn “Notting Hill”"